rm(list = ls())
require(miceadds)
require(stats4)
require(lmtest)
require(bbmle)
require(msm)
require(nlWaldTest)
require(sandwich)
require(stargazer)
require(mfx)
require("multiwayvcov")
require(car)
require(alr3)
 
#data2old=read.csv("C:/Users/naten/OneDrive - University of Tennessee/Dean Stuff/data/infoexp2_data/responses.csv", header=TRUE)
#data13=read.csv("C:/Users/naten/OneDrive - University of Tennessee/Dean Stuff/data/columbia_experiment_july25_type13clean.csv", header=TRUE)
#data15=read.csv("C:/Users/naten/OneDrive - University of Tennessee/Dean Stuff/data/columbia_experiment_August12_type15(clean).csv", header=TRUE)

data2old=read.csv("C:/Users/naten/OneDrive - University of Tennessee/Dean Stuff/data/infoexp2_data/responses.csv", header=TRUE)
data13=read.csv("C:/Users/naten/OneDrive - University of Tennessee/Dean Stuff/data/columbia_experiment_july25_type13clean.csv", header=TRUE)
data15=read.csv("C:/Users/naten/OneDrive - University of Tennessee/Dean Stuff/data/columbia_experiment_August12_type15(clean).csv", header=TRUE)


dataframe2old=data.frame(data2old)
dataframe13=data.frame(data13)
dataframe15=data.frame(data15)


priors=c(0.5,0.6,0.75,0.85)

expframe=rbind(dataframe13,dataframe15,dataframe2old)
expframe=subset(expframe,uid>200)

#note that player 234 did not finish and so has no real data
expframe=subset(expframe,uid!=234)


#definitions
expframe$priorA=(expframe$qid==1)*0.5+(expframe$qid==5)*0.6+(expframe$qid==6)*0.75+(expframe$qid==7)*0.85
expframe$priorB=1-expframe$priorA
expframe$Aresponse=(expframe$response==6)
expframe$Bresponse=(expframe$response==7)
expframe$stateA=(expframe$state==4)
expframe$stateB=(expframe$state==10)
expframe$correct=expframe$stateA*expframe$Aresponse+expframe$stateB*expframe$Bresponse
uidlist=unique(expframe$uid)

#find N
#**
length(uidlist)
#**
#Find thresholds and look for dropping

priorchangeframe=data.frame(uid=vector('numeric'),pA0.5=vector('numeric'),pA0.5lower=vector('numeric'),pA0.5upper=vector('numeric'),pA0.6=vector('numeric'),pA0.75=vector('numeric'),pA0.85=vector('numeric'),ChangePost0.5_0.6=vector('numeric'),Chisq0.5_0.6=vector('numeric'),Prob0.5_0.6=vector('numeric'),ChangePost0.5_0.75=vector('numeric'),Chisq0.5_0.75=vector('numeric'),Prob0.5_0.75=vector('numeric'),ChangePost0.5_0.85=vector('numeric'),Chisq0.5_0.85=vector('numeric'),Prob0.5_0.85=vector('numeric'))

for(i in 1:length(uidlist)){
playframe=subset(expframe,uid==uidlist[i])
model=lm(Aresponse~factor(stateA+priorA)+0,data=playframe)
na1=model$coef[1]
na2=model$coef[2]
na3=model$coef[3]
na4=model$coef[4]
a1=model$coef[5]
a2=model$coef[6]
a3=model$coef[7]
a4=model$coef[8]

if(sum(playframe$Aresponse*(playframe$priorA==0.6))==0){
postAhigh0.6=0

}else{
postAhigh0.6=(0.6*a2)/(0.6*a2+0.4*na2)
}


if(sum(playframe$Aresponse*(playframe$priorA==0.75))==0){
postAhigh0.75=0
}else{
postAhigh0.75=(0.75*a3)/(0.75*a3+0.25*na3)
}

if(sum(playframe$Aresponse*(playframe$priorA==0.85))==0){
postAhigh0.85=0
}else{
postAhigh0.85=(0.85*a4)/(0.85*a4+0.15*na4)
}

if(sum(playframe$Aresponse*(playframe$priorA==0.5))==0){

postAhigh0.5=0
postAhigh0.5upper=0
postAhigh0.5lower=0

diff0.5_0.6=postAhigh0.5-postAhigh0.6
chisq0.5_0.6=1e7*(postAhigh0.5-postAhigh0.6>0)
diff0.5_0.6p=7.888609e-31*(postAhigh0.5-postAhigh0.6>0)+(1-7.888609e-31)*(postAhigh0.5-postAhigh0.6==0)

diff0.5_0.75=postAhigh0.5-postAhigh0.75
chisq0.5_0.75=1e7*(postAhigh0.5-postAhigh0.75>0)
diff0.5_0.75p=7.888609e-31*(postAhigh0.5-postAhigh0.75>0)+(1-7.888609e-31)*(postAhigh0.5-postAhigh0.75==0)

diff0.5_0.85=postAhigh0.5-postAhigh0.85
chisq0.5_0.85=1e7*(postAhigh0.5-postAhigh0.85>0)
diff0.5_0.85p=7.888609e-31*(postAhigh0.5-postAhigh0.85>0)+(1-7.888609e-31)*(postAhigh0.5-postAhigh0.85==0)


}else{
postAhigh0.5=(0.5*a1)/(0.5*a1+0.5*na1)

vcovmod=vcovHC(model, type="HC3")

threshsterr=as.numeric(deltamethod(~(0.5*x1)/(0.5*x1+0.5*x2),coef(model)[c(5,1)],vcovmod[c(5,1),c(5,1)]))
postAhigh0.5upper=postAhigh0.5+1.96*threshsterr
postAhigh0.5lower=postAhigh0.5-1.96*threshsterr

if(sum(playframe$Aresponse)==length(playframe$Aresponse)|sum(playframe$Aresponse)==0){
diff0.5_0.6=0
chisq0.5_0.6=0
diff0.5_0.6p=1

diff0.5_0.75=0
chisq0.5_0.75=0
diff0.5_0.75p=1

diff0.5_0.85=0
chisq0.5_0.85=0
diff0.5_0.85p=1

}else{

diff0.5_0.6=postAhigh0.5-postAhigh0.6
if (sum(playframe$Aresponse*(playframe$priorA==0.5))==sum(playframe$Aresponse*(playframe$priorA==0.6))){
chisq0.5_0.6=0
diff0.5_0.6p=1
}else{
test0.5_0.6=nlWaldtest(model,"(0.5*b[5])/(0.5*b[5]+0.5*b[1])-(0.6*b[6])/(0.6*b[6]+0.4*b[2])",Vcov=vcovmod)
chisq0.5_0.6=as.numeric(test0.5_0.6[1])
diff0.5_0.6p=as.numeric(test0.5_0.6[4])
}

diff0.5_0.75=postAhigh0.5-postAhigh0.75
test0.5_0.75=nlWaldtest(model,"(0.5*b[5])/(0.5*b[5]+0.5*b[1])-(0.75*b[7])/(0.75*b[7]+0.25*b[3])",Vcov=vcovmod)
chisq0.5_0.75=as.numeric(test0.5_0.75[1])
diff0.5_0.75p=as.numeric(test0.5_0.75[4])

diff0.5_0.85=postAhigh0.5-postAhigh0.85
test0.5_0.85=nlWaldtest(model,"(0.5*b[5])/(0.5*b[5]+0.5*b[1])-(0.85*b[8])/(0.85*b[8]+0.15*b[4])",Vcov=vcovmod)
chisq0.5_0.85=as.numeric(test0.5_0.85[1])
diff0.5_0.85p=as.numeric(test0.5_0.85[4])

}

}
addframe=data.frame(uid=uidlist[i],pA0.5=postAhigh0.5,pA0.5lower=postAhigh0.5lower,pA0.5upper=postAhigh0.5upper,pA0.6=postAhigh0.6,pA0.75=postAhigh0.75,pA0.85=postAhigh0.85,ChangePost0.5_0.6=diff0.5_0.6,Chisq0.5_0.6=chisq0.5_0.6,Prob0.5_0.6=diff0.5_0.6p,ChangePost0.5_0.75=diff0.5_0.75,Chisq0.5_0.75=chisq0.5_0.75,Prob0.5_0.75=diff0.5_0.75p,ChangePost0.5_0.85=diff0.5_0.85,Chisq0.5_0.85=chisq0.5_0.85,Prob0.5_0.85=diff0.5_0.85p)


priorchangeframe=rbind(priorchangeframe,addframe)
}

percent=vector('numeric')
percent[1]=100*sum((priorchangeframe$pA0.5<0.6))/length(priorchangeframe$uid)
percent[2]=100*sum((priorchangeframe$pA0.5>=0.6)*(priorchangeframe$pA0.5<0.75))/length(priorchangeframe$uid)
percent[3]=100*sum((priorchangeframe$pA0.5>=0.75)*(priorchangeframe$pA0.5<0.85))/length(priorchangeframe$uid)
percent[4]=100*sum((priorchangeframe$pA0.5>=0.85)*(priorchangeframe$pA0.5<=1))/length(priorchangeframe$uid)
thresholds=c("[0.5,0.6)","[0.6,0.75)","[0.75,0.85)","[0.85,1]")

thresholdsframe=data.frame(Theshold=thresholds,Percent=percent)

#***********************************
stargazer(thresholdsframe,rownames=FALSE,summary=FALSE)
#***********************************

########################################################################
#check at each posterior how many people drop
#set the insignificant information threshold
#*************do with k=3 and k=0**
k=3
k=0
#**********************************
#set prior for checking
pri=0.6
infogatherframe0.6=data.frame(uid=vector('numeric'),shoulddrop=vector('numeric'),notdrop=vector('numeric'),kthreshdropped=vector('numeric'),betterthanA=vector('numeric'),significantchange=vector('numeric'))
for (i in 1:length(uidlist)){
pcfrow=subset(priorchangeframe, uid==uidlist[i])
playframe=subset(expframe,uid==uidlist[i]&priorA==pri)
sd=(pcfrow$pA0.5upper<pri)
nd=(pcfrow$pA0.5lower>pri)
ktd=(length(playframe$Aresponse)-sum(playframe$Aresponse)<=k)
btA=(sum(playframe$correct)>pri)
sigc=pcfrow$Prob0.5_0.6<0.05
addframe=data.frame(uid=uidlist[i],shoulddrop=sd,notdrop=nd,kthreshdropped=ktd,betterthanA=btA,significantchange=sigc)
infogatherframe0.6=rbind(infogatherframe0.6,addframe)
}


pri=0.75
infogatherframe0.75=data.frame(uid=vector('numeric'),shoulddrop=vector('numeric'),notdrop=vector('numeric'),kthreshdropped=vector('numeric'),betterthanA=vector('numeric'),significantchange=vector('numeric'))
for (i in 1:length(uidlist)){
pcfrow=subset(priorchangeframe, uid==uidlist[i])
playframe=subset(expframe,uid==uidlist[i]&priorA==pri)
sd=(pcfrow$pA0.5upper<pri)
nd=(pcfrow$pA0.5lower>pri)
ktd=(length(playframe$Aresponse)-sum(playframe$Aresponse)<=k)
btA=(sum(playframe$correct)>pri)
sigc=(pcfrow$Prob0.5_0.75<0.05)
addframe=data.frame(uid=uidlist[i],shoulddrop=sd,notdrop=nd,kthreshdropped=ktd,betterthanA=btA,significantchange=sigc)
infogatherframe0.75=rbind(infogatherframe0.75,addframe)
}

pri=0.85
infogatherframe0.85=data.frame(uid=vector('numeric'),shoulddrop=vector('numeric'),notdrop=vector('numeric'),kthreshdropped=vector('numeric'),betterthanA=vector('numeric'),significantchange=vector('numeric'))
for (i in 1:length(uidlist)){
pcfrow=subset(priorchangeframe, uid==uidlist[i])
playframe=subset(expframe,uid==uidlist[i]&priorA==pri)
sd=(pcfrow$pA0.5upper<pri)
nd=(pcfrow$pA0.5lower>pri)
ktd=(length(playframe$Aresponse)-sum(playframe$Aresponse)<=k)
btA=(sum(playframe$correct)>pri)
sigc=pcfrow$Prob0.5_0.85<0.05
addframe=data.frame(uid=uidlist[i],shoulddrop=sd,notdrop=nd,kthreshdropped=ktd,betterthanA=btA,significantchange=sigc)
infogatherframe0.85=rbind(infogatherframe0.85,addframe)
}

mu=c(0.6,0.75,0.85)
below0.6perc=100*sum(infogatherframe0.6$kthreshdropped*(infogatherframe0.6$shoulddrop))/sum(infogatherframe0.6$shoulddrop)
above0.6perc=100*sum(infogatherframe0.6$kthreshdropped*(infogatherframe0.6$notdrop))/sum(infogatherframe0.6$notdrop)

below0.75perc=100*sum(infogatherframe0.75$kthreshdropped*(infogatherframe0.75$shoulddrop))/sum(infogatherframe0.75$shoulddrop)
above0.75perc=100*sum(infogatherframe0.75$kthreshdropped*(infogatherframe0.75$notdrop))/sum(infogatherframe0.75$notdrop)

below0.85perc=100*sum(infogatherframe0.85$kthreshdropped*(infogatherframe0.85$shoulddrop))/sum(infogatherframe0.85$shoulddrop)
above0.85perc=100*sum(infogatherframe0.85$kthreshdropped*(infogatherframe0.85$notdrop))/sum(infogatherframe0.85$notdrop)

thresholdbelowmu=c(below0.6perc,below0.75perc,below0.85perc)
thresholdabovemu=c(above0.6perc,above0.75perc,above0.85perc)

droppingframe=data.frame(Mu=mu,Thresholdbelowmu=thresholdbelowmu,Thresholdabovemu=thresholdabovemu)
droppingframe=t(droppingframe)

#*********************************************
stargazer(droppingframe,colnames=FALSE,summary=FALSE)
#*********************************************

